Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/0292.ZIP/DB3DOC.PRG

Text File | 1985-09-23 | 5KB | 153 lines

* DB3DOC.PRG
* Author : Steve Aidikonis - AIDCOM 312/289-2390
* Created: August, 1985
* For dBASE III, this program shows the use of the COPY STRUCTURE EXTENDED
* command.
* This program will help document the data file of your choosing
SET TALK OFF
SET DELIM OFF
CLEAR ALL
CLEAR
* the memvar BIGLOOP is the main loop - Program will keep doing it's
* thing until you tell it to stop or enter an invalid file name
BIGLOOP=.T.
DO WHILE BIGLOOP
  CLEAR
  @ 2,0 SAY "dBASE III Database Document Maker"
  STORE "  A I D C O M      312/289-2390  " TO CMRCL
  @ 4,0 GET CMRCL
  CLEAR GETS
  RELEASE CMRCL
  @ 10,0
  ACCE "Please enter the database name: " TO MFILE
  STORE UPPER(MFILE)+".DBF" TO MFILE
  * look for the .DBF - if it's not there, exit
  IF .NOT. FILE('&MFILE')
    CLEAR
    @ 10,0 SAY "Data file doesn'T EXIST... EXITING."
    CLEAR ALL
    SET DELIM ON
    RETURN
  ENDIF
  USE &MFILE
  * take a look at the file structure before starting
  DISPLAY STRUCTURE
  ?
  ? "====================================="
  ?
  ACCEPT "Press <CR> =====> " TO X
  CLEAR
  MDESCRIP=SPACE(30)
  * memvar MDESCRIP allows for a 30 char. general description of the file.
  @ 5,0 SAY "File Description, &MFILE : " GET MDESCRIP
  READ
  * here's the biggie - STRUCTURE EXTENDED creates a database containing
  * only the names, length, type and decimal spaces for your file
  COPY TO DOCS STRUCTURE EXTENDED
  CLEAR
  USE DOCS
  GO TOP
  @ 1,1 SAY "Data File:"
  @ 1,13 SAY MFILE
  @ 1,33 SAY "File Descrip.:"
  @ 1,49 SAY MDESCRIP
  @ 2,0 SAY "_______________________________________________________"
  @ 2,55 SAY "________________________"
  @ 4,0 SAY "Field No.       Field Name    Type    Width    Dec."
  @ 4,55 SAY "Field Description"
  @ 5,0 SAY "=========       ==========    ====    =====    ===="
  @ 5,55 SAY "========================="
  STORE 6 TO LINE
  STORE 1 TO COUNTER
  * go down the list of field names to allow addition of less terse field
  * descriptions
  DO WHILE .NOT. EOF()
    * set up a blank memvar to store field descriptions
    STORE STR(COUNTER+10,2) TO CSTR
    STORE SPACE(25) TO MFDES&CSTR
    @ LINE,2 SAY STR(COUNTER,2)
    @ LINE,16 SAY FIELD_NAME
    @ LINE,31 SAY FIELD_TYPE
    @ LINE,39 SAY FIELD_LEN
    @ LINE,48 SAY FIELD_DEC
    @ LINE,55 GET MFDES&CSTR
    READ
    CLEAR GETS
    SKIP
    * increment the line and field counters
    LINE=LINE+1
    COUNTER=COUNTER+1
    * if we filled up one screen, clear for another
    IF LINE=24
      @ 6,0 CLEAR
      LINE=6
    ENDIF
  ENDDO
  * end of file? Print it!!
  CLEAR
  ACCEPT "Turn on the printer and press <CR> =======> " TO X
  CLEAR
  @ 10,0 SAY "Printing the documentation for "+MFILE
  GOTO TOP
  SET DEVICE TO PRINT
  COUNTER=1
  HEADING=.T.
  DO WHILE .NOT. EOF()
    IF HEADING
      @ 1,1 SAY "Today's Date:"
      @ 1,16 SAY DATE()
      @ 3,1 SAY "Data File:"
      @ 3,13 SAY MFILE
      @ 3,33 SAY "File Descrip.:"
      @ 3,49 SAY MDESCRIP
      @ 4,0 SAY "_______________________________________________________"
      @ 4,55 SAY "________________________"
      @ 5,0 SAY "Field No.       Field Name    Type    Width    Dec."
      @ 5,55 SAY "Field Description"
      @ 6,0 SAY "=========       ==========    ====    =====    ===="
      @ 6,55 SAY "========================="
      LINE=7
      HEADING=.F.
    ENDIF
    STORE STR(COUNTER+10,2) TO CSTR
    @ LINE,2 SAY STR(COUNTER,2)
    @ LINE,16 SAY FIELD_NAME
    @ LINE,31 SAY FIELD_TYPE
    @ LINE,39 SAY FIELD_LEN
    @ LINE,48 SAY FIELD_DEC
    @ LINE,55 SAY MFDES&CSTR
    SKIP
    STORE LINE+1 TO LINE
    STORE COUNTER+1 TO COUNTER
    IF LINE>56
      HEADING=.T.
    ENDIF
  ENDDO
  STORE LINE+1 TO LINE
  @ LINE,0 SAY "_______________________________________________________"
  @ LINE,55 SAY "________________________"
  SET DEVI TO SCREEN
  USE
  * finished printing, erase the structure file
  ERASE DOCS.DBF
  EJECT
  CLEAR
  * check to see if there are any more files you wish to document
  STORE ' ' TO ANS
  DO WHILE AT(ANS,'YN')=0
    @ 10,0 SAY "Do you wish to document another Database? ===> " ;
    GET ANS PICT '!'
    READ
  ENDDO
  * if not, exit the loop and the program
  IF ANS='N'
    STORE .F. TO BIGLOOP
  ENDIF
ENDDO
@ 10,0
@ 10,0 SAY "THAT'S ALL FOLKS!"
SET DELIM ON
RETURN
********* END OF FILE
*******************************************************************